% slbefunge - substandard lisp befunge interpreter
% author: Nicky Nickell <nicky.nickell@gmail.com>

(de linkify (src &optional text)
  (dom-append (dom-create "a" (list (cons "href" src))) (cond ((null text) src)
                                                              (t text))))
(de range (start end)
  (cond ((greaterp start end)
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (sub1 start) end)))))
        (t
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (add1 start) end)))))))

(setq ip (cons 0 0))
(setq delta (cons 0 1))
(setq state (list ip delta))
(setq mem nil)
(setq stack nil)

(de step-ip (ip delta)
  (progn (rplaca ip (plus (car ip) (car delta)))
         (rplacd ip (plus (cdr ip) (cdr delta)))))

(de instruction-fetch (m ip)
  (vector-fetch (vector-fetch m (car ip)) (cdr ip)))

(de load-program nil nil) % parse program from textarea
(de execute-one nil nil) % execute one instruction, step the ip
(de run-program nil nil) % call execute-one in a loop
(de animate-program nil nil) % call setInterval (for which there is currently
                             % no sl binding) and arrange to have one befunge
                             % instruction executed every 100ms, outputting
                             % the contents of memory each time

(dom-set-title "slbefunge")
(dom-append (dom-get-body)
  (dom-create-button "load" nil '(("onclick" . (load-program)))) "<br>"
  (dom-create "textarea" (pair '("rows" "cols" "id") '("25" "80" "program")))
  "<br>memory contents:<br>" (dom-create "div" '(("id" . "memory-output"))) 
  "<br>" (dom-create-button "run" nil '(("onclick" . (run-program))))
  (dom-create-button "animate" nil '(("onclick" . (animate-program)))) "<br>"
  "input: " (dom-create-text '(("id" . "input"))) "<br>"
  "output: " (dom-create "div" '(("id" . "output")))
  "<br><br><br>animation inspired by " 
  (linkify "http://www.quirkster.com/js/befunge.html" "this interpreter."))
